home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / SCRLFILE.BAS < prev    next >
BASIC Source File  |  1997-06-02  |  4KB  |  180 lines
  1. 'From: cadwright@aol.com (CadWright)
  2. 'Newsgroups: comp.lang.basic.misc
  3. 'Date: 1 Jun 1997 11:24:06 GMT
  4.  
  5. 'Here's a scroll through file list routine which I've chopped
  6. 'out of one of my proggies. I don't have time to add drive
  7. 'and directory support, maybe someone else can add
  8. 'it....
  9.  
  10. 'BTW, some lines may wrap and the TAB formatting may
  11. 'be a bit screwy :)
  12.  
  13. 'Craig Wright
  14.  
  15. '$INCLUDE: 'qb.bi'
  16.  
  17. DEFINT A-Z
  18. DECLARE FUNCTION Dir$ (FileSpec$)
  19. DECLARE SUB ShowAllFiles ()
  20. DECLARE SUB ShowOneFile (ForeGround%, BackGround%)
  21.  
  22. 'maximum files to be displayed on screen, for text mode 80x25 this will be 25
  23. CONST FilesDisplayed = 16
  24.  
  25. 'TopRow (0 to 24) and LeftColumn (1 to 68) of virtual window to display files
  26. 'in - TopRow+FilesDisplayed must be <25
  27. CONST TopRow = 1, LeftCol = 5
  28.  
  29. 'holds the file list, 512 entries, increase it for more
  30. DIM SHARED FileList(512) AS STRING * 12
  31. COMMON SHARED CurrentFile, BarPosition, MaxFiles
  32.  
  33. '********* code starts
  34. 'create blue background around file list window
  35. COLOR 7, 0: CLS
  36. VIEW PRINT 1 TO FilesDisplayed + 2
  37. COLOR 0, 1: CLS 2
  38. VIEW PRINT: COLOR 7, 0
  39.  
  40. 'total files in directory
  41. MaxFiles = 0
  42.  
  43. 'first call to get all files in directory
  44. FileFound$ = Dir$("*.*")
  45. IF LEN(FileFound$) THEN
  46.     'found valid files so get rest of files in dir
  47.     DO
  48.     IF LEN(FileFound$) THEN
  49.         'found a file, increment counter and stick in array
  50.         MaxFiles = MaxFiles + 1
  51.         FileList(MaxFiles) = FileFound$
  52.         IF MaxFiles >= UBOUND(FileList) THEN EXIT DO   'exceeds file list
  53.     ELSE
  54.         EXIT DO   'no more files
  55.     END IF
  56.     FileFound$ = Dir$("")
  57.     LOOP
  58. END IF
  59.  
  60.  
  61. CurrentFile = 1  'set to first file in list
  62. BarPosition = 0  'force screen update on first time through
  63.  
  64. '********* main scroll through file loop
  65. DO
  66.     'check array limits
  67.     IF CurrentFile < 1 THEN
  68.     CurrentFile = 1
  69.     BarPosition = 1
  70.     END IF
  71.     IF CurrentFile > MaxFiles THEN
  72.     CurrentFile = MaxFiles
  73.     BarPosition = BarPosition - 1
  74.     END IF
  75.      
  76.     'check file window limits
  77.     IF BarPosition < 1 THEN
  78.     BarPosition = 1
  79.     ShowAllFiles
  80.     END IF
  81.     IF BarPosition > FilesDisplayed THEN
  82.     BarPosition = FilesDisplayed
  83.     'may not be enough files to fill the file window
  84.     IF BarPosition > MaxFiles THEN BarPosition = MaxFiles
  85.     ShowAllFiles
  86.     END IF
  87.      
  88.     ShowOneFile 0, 7    'hilight current file
  89.      
  90.     DO      'get users key press..duhhh !
  91.         z$ = INKEY$
  92.     LOOP UNTIL z$ > ""
  93.      
  94.     ShowOneFile 7, 0    'display file normally
  95.      
  96.     SELECT CASE RIGHT$(z$, 1)
  97.         CASE CHR$(72)     'up
  98.             CurrentFile = CurrentFile - 1   'actual file in list
  99.             BarPosition = BarPosition - 1   'bar position in file window
  100.         CASE CHR$(80)     'down
  101.             CurrentFile = CurrentFile + 1
  102.             BarPosition = BarPosition + 1
  103.         CASE CHR$(13)     'return
  104.             LOCATE 23, 1: PRINT "File selected : "; FileList(CurrentFile)
  105.             END
  106.     END SELECT
  107.  
  108. LOOP
  109.  
  110. DEFSNG A-Z
  111. FUNCTION Dir$ (FileSpec$) STATIC
  112.  
  113.     DIM DTA AS STRING * 44, Regs AS RegTypeX
  114.  
  115.     Regs.ax = &H1A00
  116.     Regs.dx = VARPTR(DTA)
  117.     Regs.ds = -1
  118.     INTERRUPTX &H21, Regs, Regs
  119.      
  120.     IF LEN(FileSpec$) THEN
  121.             'first time through
  122.         FileA$ = FileSpec$ + CHR$(0)
  123.         Regs.ax = &H4E00
  124.         Regs.cx = 0
  125.         Regs.dx = SADD(FileA$)
  126.         Regs.ds = -1
  127.          
  128.     ELSE
  129.             'no FileSpec$ so find next file
  130.         Regs.ax = &H4F00
  131.          
  132.     END IF
  133.  
  134.     INTERRUPTX &H21, Regs, Regs
  135.      
  136.     IF Regs.flags AND 1 THEN
  137.             'no files found - return nothing
  138.         Dir$ = ""
  139.     ELSE
  140.             'get file found and return file name
  141.         Null = INSTR(31, DTA, CHR$(0))
  142.         Dir$ = MID$(DTA, 31, Null - 30)
  143.     END IF
  144.  
  145. END FUNCTION
  146.  
  147. DEFINT A-Z
  148. SUB ShowAllFiles
  149.  
  150. 'fills up the file window
  151.  
  152. start = 1 + CurrentFile - BarPosition
  153.  
  154. FOR i = start TO start + FilesDisplayed - 1
  155.  
  156.     IF i > MaxFiles THEN
  157.     'if not enough files to fill up the file window then
  158.     'fill up with empty entries
  159.     FOR b = i - CurrentFile + BarPosition TO FilesDisplayed
  160.         LOCATE TopRow + b - CurrentFile + BarPosition, LeftCol:
  161.         PRINT SPACE$(LEN(FileList(1)))
  162.     NEXT
  163.     EXIT FOR
  164.     END IF
  165.  
  166.     LOCATE TopRow + i - CurrentFile + BarPosition, LeftCol:
  167.     PRINT FileList(i)
  168. NEXT
  169.  
  170. END SUB
  171.  
  172. SUB ShowOneFile (ForeGround%, BackGround%)
  173.  
  174. 'refreshes a single file in the file window
  175. COLOR ForeGround%, BackGround%
  176. LOCATE TopRow + BarPosition, LeftCol: PRINT FileList(CurrentFile)
  177.  
  178. END SUB
  179.  
  180.